home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #5 / Amiga Plus CD - 2000 - No. 5.iso / Tools / Dev / fpc / utilunits / linklist.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-01-01  |  21.7 KB  |  806 lines
  1. {
  2.     This file is part of the Free Pascal run time library.
  3.  
  4.     A file in Amiga system run time library.
  5.     Copyright (c) 1998-2000 by Nils Sjoholm
  6.     member of the Amiga RTL development team.
  7.  
  8.     See the file COPYING.FPC, included in this distribution,
  9.     for details about the copyright.
  10.  
  11.     This program is distributed in the hope that it will be useful,
  12.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  13.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  14.  
  15.  **********************************************************************}
  16.  
  17. unit linklist;
  18.  
  19. {
  20.    A unit for an easy way to use exec linked lists
  21.    for Amiga. Can also be used for other platforms
  22.    as it is. I hope.
  23.    
  24.    27 Oct 1998.
  25.    nils.sjoholm@mailbox.swipnet.se
  26. }
  27.  
  28. interface
  29.  
  30. uses
  31. {$ifdef Amiga}
  32.    Exec,amigalib,
  33. {$endif}
  34.    strings;
  35.  
  36. { $define showall}
  37.  
  38. {$ifndef Amiga}
  39. type
  40.  
  41.     pNode = ^tNode;
  42.     tNode = record
  43.         ln_Succ: pNode;
  44.         ln_Pred: pNode;
  45.         ln_Type: byte;
  46.         ln_Pri : shortint;
  47.         ln_Name: pchar;
  48.         end;
  49.  
  50.     pList = ^tList;
  51.     tList = record
  52.         lh_Head: pNode;
  53.         lh_Tail: pNode;
  54.         lh_TailPred: pNode;
  55.         lh_Type: byte;
  56.         l_pad: byte;
  57.         end;
  58.  
  59. {$endif}
  60.  
  61. type
  62.     pFPCNode = ^tFPCNode;
  63.     tFPCNode = record
  64.         ln_Succ   : pNode;
  65.         ln_Pred   : pNode;
  66.         ln_Type   : Byte;
  67.         ln_Pri    : Shortint;
  68.         ln_Name   : PChar;
  69. {
  70.    Increase this record if you need more information
  71.    just add your own to the record. Don't forget to
  72.    change the functions or add your own functions.
  73. }
  74.         ln_Size   : Longint;
  75.         end;
  76.  
  77. {$ifndef Amiga}
  78. procedure NewList (list: pList);
  79. procedure AddHead(list : pList; node : pNode);
  80. procedure AddTail(list : pList; node : pNode);
  81. procedure Insert(list : pList; node, lnode: pNode);
  82. procedure Remove(node : pNode);
  83. function RemHead(list : pList): pNode;
  84. function RemTail(list : pList): pNode;
  85. {$endif}
  86.  
  87. FUNCTION AddNewNode(VAR fpclist : pList; Str : PChar): pFPCNode;
  88. FUNCTION AddNewNode(VAR fpclist : pList; Str : String): pFPCNode;
  89. PROCEDURE ClearList(VAR fpclist : pList);
  90. PROCEDURE CreateList(VAR fpclist : pList);
  91. FUNCTION CopyList(fpclist : pList): pList;
  92. PROCEDURE DeleteNode(ANode : pFPCNode);
  93. PROCEDURE DestroyList(VAR fpclist : pList);
  94. FUNCTION FindNodeData(fpclist : pList; data : PChar): pFPCNode;
  95. FUNCTION FindNodeData(fpclist : pList; data : String): pFPCNode;
  96. FUNCTION GetFirstNode(fpclist : pList): pFPCNode;
  97. FUNCTION GetLastNode(fpclist : pList): pFPCNode;
  98. FUNCTION GetNextNode( ANode : pFPCNode): pFPCNode;
  99. FUNCTION GetNodeData(Anode : pFPCNode): PChar;
  100. FUNCTION GetNodeNumber(fpclist : pList; num : Longint): pFPCNode;
  101. FUNCTION GetPrevNode( ANode : pFPCNode): pFPCNode;
  102. FUNCTION InsertNewNode(var fpclist : pList; data : PChar; Anode : pFPCNode): pFPCNode;
  103. FUNCTION InsertNewNode(var fpclist : pList; data : String; Anode : pFPCNode): pFPCNode;
  104. PROCEDURE ListToBuffer(fpclist : pList; VAR buf : PChar);
  105. FUNCTION MergeLists(firstlist , secondlist : pList): pList;
  106. PROCEDURE MoveNodeBottom(var fpclist: pList; ANode : pFPCNode);
  107. PROCEDURE MoveNodeDown(VAR fpclist : pList; ANode : pFPCNode);
  108. PROCEDURE MoveNodeTop(VAR fpclist: pList; ANode : pFPCNode);
  109. PROCEDURE MoveNodeUp(VAR fpclist : pList; ANode : pFPCNode);
  110. FUNCTION NodesInList(fpclist :  pList): Longint;
  111. PROCEDURE PrintList(fpclist : pList);
  112. PROCEDURE RemoveDupNode( VAR fpclist :  pList);
  113. PROCEDURE RemoveLastNode(VAR fpclist : pList);
  114. FUNCTION SizeOfList(fpclist : pList): Longint;
  115. PROCEDURE SortList(VAR fpclist: pList);
  116. FUNCTION UpDateNode(ANode : pFPCNode; data : PChar): BOOLEAN;
  117. FUNCTION UpDateNode(ANode : pFPCNode; data : String): BOOLEAN;
  118.  
  119. function FileToList(thefile : PChar; var thelist : pList): boolean;
  120. function FileToList(thefile : String; var thelist : pList): boolean;
  121. function ListToFile(TheFile : PChar; thelist : pList): Boolean;
  122. function ListToFile(TheFile : String; thelist : pList): Boolean;
  123.  
  124. implementation
  125.  
  126. {$ifndef Amiga}
  127. procedure NewList (list: pList);
  128. begin
  129.     list^.lh_Head     := pNode(@list^.lh_Tail);
  130.     list^.lh_Tail     := NIL;
  131.     list^.lh_TailPred := pNode(@list^.lh_Head)
  132. end;
  133.  
  134.  
  135. procedure AddHead(list : pList; node : pNode);
  136. begin
  137.     node^.ln_Succ := list^.lh_Head;
  138.     node^.ln_Pred := pNode(@list^.lh_Head);
  139.     list^.lh_Head^.ln_Pred := node;
  140.     list^.lh_Head := node;
  141. end;
  142.  
  143. procedure AddTail(list : pList; node : pNode);
  144. begin
  145.     node^.ln_Succ := pNode(@list^.lh_Tail);
  146.     node^.ln_Pred := list^.lh_TailPred;
  147.     list^.lh_TailPred^.ln_Succ := node;
  148.     list^.lh_TailPred := node;
  149. end;
  150.  
  151. procedure Insert(list : pList; node : pNode; lnode: pNode);
  152. begin
  153.     {*
  154.      *  Insert node after lnode.  If lnode = NIL then insert
  155.      *  at head of list.
  156.      *}
  157.  
  158.     if (lnode = NIL) then lnode := pNode(@list^.lh_Head);
  159.     node^.ln_Pred := lnode;
  160.     node^.ln_Succ := lnode^.ln_Succ;
  161.     lnode^.ln_Succ := node;
  162.     node^.ln_Succ^.ln_Pred := node;
  163. end;
  164.  
  165. procedure Remove(node : pNode);
  166. begin
  167.     node^.ln_Succ^.ln_Pred := node^.ln_Pred;
  168.     node^.ln_Pred^.ln_Succ := node^.ln_Succ;
  169.     node^.ln_Succ := NIL;
  170.     node^.ln_Pred := NIL;
  171. end;
  172.  
  173. function RemHead(list : pList): pNode;
  174. var
  175.     node : pNode;
  176. begin
  177.     node := list^.lh_Head;
  178.     if (node^.ln_Succ <> NIL) then begin
  179.         node^.ln_Succ^.ln_Pred := node^.ln_Pred;
  180.         node^.ln_Pred^.ln_Succ := node^.ln_Succ;
  181.         node^.ln_Succ := NIL;
  182.         node^.ln_Pred := NIL;
  183.     end else node := NIL;
  184.     RemHead := node;
  185. end;
  186.  
  187. function RemTail(list : pList): pNode;
  188. var
  189.     node : pNode;
  190. begin
  191.     node := list^.lh_TailPred;
  192.     if (node^.ln_Pred <> NIL) then Remove(node)
  193.        else node := NIL;
  194.     RemTail := node;
  195. end;
  196.  
  197. {$endif}
  198.  
  199. FUNCTION AddNewNode(VAR fpclist : pList; Str : PChar): pFPCNode;
  200. VAR
  201.    tempnode : pFPCNode;
  202. BEGIN
  203.    New(tempnode);
  204.    tempnode^.ln_Name := StrAlloc(StrLen(Str)+1);
  205.    IF tempnode^.ln_Name <>  NIL THEN BEGIN
  206.       StrCopy(tempnode^.ln_Name,Str);
  207.       tempnode^.ln_Size := 0;
  208.       tempnode^.ln_Type := 0;
  209.       tempnode^.ln_Pri  := 0;
  210.       AddTail(fpclist,pNode(tempnode));
  211.       AddNewNode := tempnode;
  212.    END ELSE BEGIN
  213.       AddNewNode := NIL;
  214.    END;
  215. END;
  216.  
  217. FUNCTION AddNewNode(VAR fpclist : pList; Str : String): pFPCNode;
  218. VAR
  219.    tempnode : pFPCNode;
  220. BEGIN
  221.    New(tempnode);
  222.    tempnode^.ln_Name := StrAlloc(Length(Str)+1);
  223.    IF tempnode^.ln_Name <>  NIL THEN BEGIN
  224.       StrPCopy(tempnode^.ln_Name,Str);
  225.       tempnode^.ln_Size := 0;
  226.       tempnode^.ln_Type := 0;
  227.       tempnode^.ln_Pri  := 0;
  228.       AddTail(fpclist,pNode(tempnode));
  229.       AddNewNode := tempnode;
  230.    END ELSE BEGIN
  231.       AddNewNode := NIL;
  232.    END;
  233. END;
  234.  
  235. PROCEDURE ClearList(VAR fpclist : pList);
  236. VAR
  237.    tempnode : pFPCNode;
  238.    dummy    : pNode;
  239. BEGIN
  240.    WHILE fpclist^.lh_Head <> @fpclist^.lh_Tail DO BEGIN
  241.        tempnode := pFPCNode(fpclist^.lh_Head);
  242.        if tempnode <> nil then begin
  243.            if tempnode^.ln_Name <> nil then begin
  244.               StrDispose(tempnode^.ln_Name);
  245.            end;
  246.            dummy := RemHead(fpclist);
  247.            Dispose(tempnode);
  248.        end;
  249.    END;
  250. END;
  251.  
  252. FUNCTION CopyList(fpclist : pList): pList;
  253. VAR
  254.     templist : pList;
  255.     tempnode : pFPCNode;
  256.     i, dummy : Longint;
  257.     added    : pFPCNode;
  258. BEGIN
  259.     CreateList(templist);
  260.     i := NodesInList(fpclist);
  261.     tempnode := pFPCNode(fpclist^.lh_Head);
  262.     FOR dummy := 1 TO i DO BEGIN
  263.        added := AddNewNode(templist,tempnode^.ln_Name);
  264.        tempnode := pFPCNode(tempnode^.ln_Succ);
  265.     END;
  266.     IF added = NIL THEN BEGIN
  267.        CopyList := NIL;
  268.     END ELSE BEGIN
  269.        CopyList := templist;
  270.     END;
  271. END;                        
  272.  
  273. PROCEDURE CreateList(VAR fpclist : pList);
  274. BEGIN
  275.     New(fpclist);
  276.     NewList(fpclist);
  277. END;                         
  278.  
  279. PROCEDURE DeleteNode(ANode : pFPCNode);
  280. BEGIN
  281.    IF Assigned(ANode)THEN BEGIN
  282.        IF Assigned(ANode^.ln_Name)THEN BEGIN
  283.             StrDispose(ANode^.ln_Name);
  284.        END;
  285.        Remove(pNode(ANode));
  286.        Dispose(ANode);
  287.    END;
  288. END;
  289.  
  290. { remove all nodes, list is killed }
  291. PROCEDURE DestroyList(VAR fpclist : pList);
  292. VAR
  293.    tempnode : pFPCNode;
  294.    dummy    : pNode;
  295. BEGIN
  296.  WHILE fpclist^.lh_Head <> @fpclist^.lh_Tail DO BEGIN
  297.        tempnode := pFPCNode(fpclist^.lh_Head);
  298.        if Assigned(tempnode) then begin
  299.            if Assigned(tempnode^.ln_Name) then begin
  300.               {$ifdef showall}
  301.                   write('releasing ');
  302.                   writeln(tempnode^.ln_Name);
  303.               {$endif}
  304.               StrDispose(tempnode^.ln_Name);
  305.            end;
  306.            dummy := RemHead(fpclist);
  307.            {$ifdef showall}
  308.               writeln('Disposing node');
  309.            {$endif}  
  310.            Dispose(tempnode);
  311.        end;
  312.    END;
  313.    if Assigned(fpclist) then begin
  314.       {$ifdef showall}
  315.           writeln('Disposing of list');
  316.       {$endif} 
  317.       Dispose(fpclist);
  318.       fpclist := nil;
  319.    end; 
  320. END;                                    
  321.  
  322. FUNCTION FindNodeData(fpclist : pList; data : PChar): pFPCNode;
  323. VAR
  324.     temp : pFPCNode;
  325.     result : pFPCNode;
  326. BEGIN
  327.     result := NIL;
  328.     IF fpclist^.lh_Head^.ln_Succ <> NIL THEN BEGIN
  329.         temp := pFPCNode(fpclist^.lh_Head);
  330.         WHILE (temp^.ln_Succ <> NIL) DO BEGIN
  331.             IF (StrIComp(temp^.ln_Name,data)=0) THEN BEGIN
  332.                 result := temp;
  333.                 break;
  334.             END;
  335.             temp := pFPCNode(temp^.ln_Succ);
  336.         END;
  337.     END;
  338.     FindNodeData := result;
  339. END;
  340.  
  341. FUNCTION FindNodeData(fpclist : pList; data : String): pFPCNode;
  342. VAR
  343.     temp : pFPCNode;
  344.     result : pFPCNode;
  345.     p : PChar;
  346. BEGIN
  347.     result := NIL;
  348.     p := StrAlloc(length(data)+1);
  349.     StrPCopy(p,data);
  350.     IF fpclist^.lh_Head^.ln_Succ <> NIL THEN BEGIN
  351.         temp := pFPCNode(fpclist^.lh_Head);
  352.         WHILE (temp^.ln_Succ <> NIL) DO BEGIN
  353.             IF (StrIComp(temp^.ln_Name,p)=0) THEN BEGIN
  354.                 result := temp;
  355.                 break;
  356.             END;
  357.             temp := pFPCNode(temp^.ln_Succ);
  358.         END;
  359.     END;
  360.     StrDispose(p);
  361.     FindNodeData := result;
  362. END;
  363.  
  364. FUNCTION GetFirstNode(fpclist : pList): pFPCNode;
  365. var
  366.     head : pFPCNode;
  367. BEGIN
  368.     head := pFPCNode(fpclist^.lh_Head);
  369.     if head^.ln_Succ <> nil then begin
  370.         GetFirstNode := pFPCNode(head);
  371.     end else GetFirstNode := nil;
  372. END;
  373.  
  374. FUNCTION GetLastNode(fpclist : pList): pFPCNode;
  375. var
  376.     tail : pFPCNode;
  377. BEGIN
  378.     tail := pFPCNode(fpclist^.lh_TailPred);
  379.     if tail^.ln_Pred <> nil then begin
  380.         GetLastNode := pFPCNode(tail);
  381.     end else GetLastNode := nil;
  382. END;       
  383.  
  384. FUNCTION GetNextNode( ANode : pFPCNode): pFPCNode;
  385. var
  386.     next : pFPCNode;
  387. BEGIN
  388.     next := pFPCNode(ANode^.ln_Succ);
  389.     if next^.ln_Succ <> nil then begin
  390.        GetNextNode := pFPCNode(next);
  391.     end else GetNextNode := nil;
  392. END;   
  393.  
  394. FUNCTION GetNodeData(Anode : pFPCNode): PChar;
  395. BEGIN
  396.    IF ANode <> NIL THEN BEGIN
  397.        IF ANode^.ln_Name <> NIL THEN BEGIN
  398.            GetNodeData := ANode^.ln_Name;
  399.        END ELSE BEGIN
  400.            GetNodeData := NIL;
  401.        END;
  402.    END;
  403. END;
  404.  
  405. FUNCTION GetNodeNumber(fpclist : pList; num : Longint): pFPCNode;
  406. VAR
  407.    dummy : Longint;
  408.    tempnode : pFPCNode;
  409. BEGIN
  410.     IF num <= NodesInList(fpclist) then begin
  411.        tempnode := pFPCNode(fpclist^.lh_Head);
  412.        FOR dummy := 1 TO num DO BEGIN
  413.           tempnode := pFPCNode(tempnode^.ln_Succ);
  414.        END;
  415.        GetNodeNumber := pFPCNode(tempnode);
  416.     END ELSE BEGIN
  417.        GetNodeNumber := NIL;
  418.     END;
  419. END;                        
  420.  
  421. FUNCTION GetPrevNode( ANode : pFPCNode): pFPCNode;
  422. var
  423.     prev : pFPCNode;
  424. BEGIN
  425.     prev := pFPCNode(ANode^.ln_Pred);
  426.     if prev^.ln_Pred <> nil then begin
  427.        GetPrevNode := pFPCNode(prev);
  428.     end else GetPrevNode := nil;
  429. END;   
  430.  
  431. FUNCTION InsertNewNode(var fpclist : pList; data : PChar; Anode : pFPCNode): pFPCNode;
  432. VAR
  433.     dummy    : pFPCNode;
  434. BEGIN
  435.     dummy := AddNewNode(fpclist,data);
  436.     IF dummy <> NIL THEN BEGIN
  437.         IF (ANode <> NIL) THEN BEGIN
  438.             Remove(pNode(dummy));
  439. {$ifdef Amiga}
  440.             ExecInsert(fpclist,pNode(dummy),pNode(Anode));
  441. {$else}
  442.             Insert(fpclist,pNode(dummy),pNode(Anode));
  443. {$endif}
  444.         END;
  445.         InsertNewNode := dummy;
  446.     END ELSE begin
  447.         InsertNewNode := NIL;
  448.     END;
  449. END;
  450.  
  451. FUNCTION InsertNewNode(var fpclist : pList; data : String; Anode : pFPCNode): pFPCNode;
  452. VAR
  453.     dummy    : pFPCNode;
  454. BEGIN
  455.     dummy := AddNewNode(fpclist,data);
  456.     IF dummy <> NIL THEN BEGIN
  457.         IF (ANode <> NIL) THEN BEGIN
  458.             Remove(pNode(dummy));
  459. {$ifdef Amiga}
  460.             ExecInsert(fpclist,pNode(dummy),pNode(Anode));
  461. {$else}
  462.             Insert(fpclist,pNode(dummy),pNode(Anode));
  463. {$endif}
  464.         END;
  465.         InsertNewNode := dummy;
  466.     END ELSE begin
  467.         InsertNewNode := NIL;
  468.     END;
  469. END;
  470.  
  471. PROCEDURE ListToBuffer(fpclist : pList; VAR buf : PChar);
  472. VAR
  473.    i     : Longint;
  474.    dummy : Longint;
  475.    tempnode : pFPCNode;
  476. BEGIN
  477.    buf[0] := #0;
  478.    i := NodesInList(fpclist);
  479.    tempnode := pFPCNode(fpclist^.lh_Head);
  480.    FOR dummy := 1 TO i DO BEGIN
  481.       IF tempnode^.ln_Name <> NIL THEN BEGIN
  482.          strcat(buf,tempnode^.ln_Name);
  483.          IF dummy < i THEN BEGIN
  484.             StrCat(buf,PChar(';'#0));
  485.          END;
  486.       END;
  487.       tempnode := pFPCNode(tempnode^.ln_Succ);
  488.    END;
  489. END;
  490.  
  491. FUNCTION MergeLists(firstlist , secondlist : pList): pList;
  492. VAR
  493.     templist : pList;
  494.     tempnode : pFPCNode;
  495.     i, dummy : Longint;
  496.     added    : pFPCNode;
  497. BEGIN
  498.     CreateList(templist);
  499.     i := NodesInList(firstlist);
  500.     tempnode := pFPCNode(firstlist^.lh_Head);
  501.     FOR dummy := 0 TO i DO BEGIN
  502.        added := AddNewNode(templist,tempnode^.ln_Name);
  503.        tempnode := pFPCNode(tempnode^.ln_Succ);
  504.     END;
  505.     IF added = NIL THEN BEGIN
  506.        MergeLists := NIL;
  507.     END ELSE BEGIN
  508.        i := NodesInList(secondlist);
  509.        tempnode := pFPCNode(secondlist^.lh_Head);
  510.        FOR dummy := 0 TO i DO BEGIN
  511.           added := AddNewNode(templist,tempnode^.ln_Name);
  512.           tempnode := pFPCNode(tempnode^.ln_Succ);
  513.        END;
  514.        IF added = NIL THEN BEGIN
  515.           MergeLists := NIL;
  516.        END ELSE BEGIN
  517.           MergeLists := templist;
  518.        END;
  519.     END;
  520. END;
  521.  
  522. { move a node to the bottom of the list }
  523. PROCEDURE MoveNodeBottom(var fpclist: pList; ANode : pFPCNode);
  524.  
  525. BEGIN
  526.     IF ANode^.ln_Succ <> NIL THEN BEGIN
  527.         Remove(pNode(ANode));
  528.         AddTail(fpclist,pNode(ANode));
  529.     END;
  530. END;
  531.  
  532. { move a node down the list }
  533. PROCEDURE MoveNodeDown(VAR fpclist : pList; ANode : pFPCNode);
  534. VAR
  535.     suc : pFPCNode;
  536. BEGIN
  537.     suc := pFPCNode(ANode^.ln_Succ);
  538.     IF (ANode <> NIL) AND (suc <> NIL) THEN BEGIN
  539.         Remove(pNode(ANode));
  540. {$ifdef Amiga}
  541.         ExecInsert(fpclist,pNode(ANode),pNode(suc));
  542. {$else}
  543.         Insert(fpclist,pNode(ANode),pNode(suc));
  544. {$endif}
  545.     END;
  546. END;
  547.  
  548. { move a node up to the top of the list }
  549. PROCEDURE MoveNodeTop(VAR fpclist: pList; ANode : pFPCNode);
  550. BEGIN
  551.     IF ANode^.ln_Pred <> NIL THEN BEGIN
  552.         Remove(pNode(ANode));
  553.         AddHead(fpclist,pNode(ANode));
  554.     END;
  555. END;
  556.  
  557. { move a node up the list }
  558. PROCEDURE MoveNodeUp(VAR fpclist : pList; ANode : pFPCNode);
  559. VAR
  560.     prev : pFPCNode;
  561. BEGIN
  562.     prev := pFPCNode(Anode^.ln_Pred);
  563.     IF (ANode <> NIL) AND (prev <> NIL) THEN BEGIN
  564.         prev := pFPCNode(prev^.ln_Pred);
  565.         Remove(pNode(ANode));
  566. {$ifdef Amiga}
  567.         ExecInsert(fpclist,pNode(ANode),pNode(prev));
  568. {$else}
  569.         Insert(fpclist,pNode(ANode),pNode(prev));
  570. {$endif}
  571.     END;
  572. END;
  573.  
  574. FUNCTION NodesInList(fpclist :  pList): Longint;
  575. VAR
  576.    tempnode : pFPCNode;
  577.    i        : Longint;
  578. BEGIN
  579.     i := 0;
  580.     tempnode := pFPCNode(fpclist^.lh_Head);
  581.     WHILE tempnode^.ln_Succ <> NIL DO BEGIN
  582.         tempnode := pFPCNode(tempnode^.ln_Succ);
  583.         INC(i);
  584.     END;
  585.     NodesInList := i;
  586. END;                    
  587.  
  588. PROCEDURE PrintList(fpclist : pList);
  589. VAR
  590.    i     : Longint;
  591.    dummy : Longint;
  592.    tempnode : pFPCNode;
  593. BEGIN
  594.  
  595.    i := NodesInList(fpclist);
  596.  
  597.    tempnode := pFPCNode(fpclist^.lh_Head);
  598.    FOR dummy := 1 TO i DO BEGIN
  599.        IF tempnode^.ln_Name <> NIL THEN BEGIN
  600.           WriteLN(tempnode^.ln_Name);
  601.        END;
  602.        tempnode := pFPCNode(tempnode^.ln_Succ);
  603.    END;
  604. END;                        
  605.  
  606. PROCEDURE RemoveDupNode( VAR fpclist :  pList);
  607. VAR
  608.    tempnode : pFPCNode;
  609.    nextnode : pFPCNode;
  610. BEGIN
  611.     tempnode := pFPCNode(fpclist^.lh_Head);
  612.  
  613.     WHILE tempnode^.ln_Succ <> NIL DO BEGIN
  614.          nextnode := pFPCNode(tempnode^.ln_Succ);
  615.         IF (StrIComp(tempnode^.ln_Name,nextnode^.ln_Name)=0) THEN BEGIN
  616.             DeleteNode(tempnode);
  617.         END;
  618.         tempnode := nextnode;
  619.     END;
  620. END;
  621.  
  622. PROCEDURE RemoveLastNode(VAR fpclist : pList);
  623. VAR
  624.    tempnode : pFPCNode;
  625.    dummy    : pNode;
  626. BEGIN
  627.    tempnode := pFPCNode(fpclist^.lh_TailPred);
  628.    if tempnode^.ln_Name <> nil then begin
  629.       StrDispose(tempnode^.ln_Name);
  630.    end;
  631.    dummy := RemTail(fpclist);
  632.    Dispose(tempnode);
  633. END;                       
  634.  
  635. { get the total size allocated by list }
  636. { size is WITH ';' between the strings }
  637. FUNCTION SizeOfList(fpclist : pList): Longint;
  638. VAR
  639.    i     : Longint;
  640.    dummy : Longint;
  641.    tempnode : pFPCNode;
  642.    tsize    : Longint;
  643. BEGIN
  644.    tsize := 0;
  645.    i := NodesInList(fpclist);
  646.  
  647.     tempnode := pFPCNode(fpclist^.lh_Head);
  648.     FOR dummy := 1 TO i DO BEGIN
  649.         IF tempnode^.ln_Name <> NIL THEN BEGIN
  650.             tsize := tsize + (StrLen(tempnode^.ln_Name)+1)
  651.         END;
  652.         tempnode := pFPCNode(tempnode^.ln_Succ);
  653.     END;
  654.     SizeOfList := tsize;
  655. END;
  656.  
  657. { sort the list using a bubble sort }
  658. PROCEDURE SortList(VAR fpclist: pList);
  659.  
  660. VAR
  661.     notfinished : BOOLEAN;
  662.     first, second : pFPCNode;
  663.     n,i : Longint;
  664.  
  665. BEGIN
  666.     IF fpclist^.lh_Head^.ln_Succ <> NIL THEN BEGIN
  667.         notfinished := True;
  668.         i := NodesInList(fpclist);
  669.         WHILE (notfinished) DO BEGIN
  670.             notfinished := FALSE;
  671.             first := pFPCNode(fpclist^.lh_Head);
  672.             IF first <> NIL THEN BEGIN
  673.                 n := 1;
  674.                 second := pFPCNode(first^.ln_Succ);
  675.                 WHILE n <> i DO BEGIN
  676.                     n := n + 1;
  677.                     IF (StrIComp(first^.ln_Name,second^.ln_Name)>0) THEN BEGIN
  678.                         Remove(pNode(first));
  679. {$ifdef Amiga}
  680.                         ExecInsert(fpclist,pNode(first),pNode(second));
  681. {$else}
  682.                         Insert(fpclist,pNode(first),pNode(second));
  683. {$endif}
  684.                         notfinished := True;
  685.                     END ELSE
  686.                         first := second;
  687.                     second := pFPCNode(first^.ln_Succ);
  688.                 END;
  689.             END;
  690.         END;
  691.     END;
  692. END;
  693.  
  694. FUNCTION UpDateNode(ANode : pFPCNode; data : PChar): BOOLEAN;
  695. VAR
  696.    result : BOOLEAN;
  697. BEGIN
  698.     IF ANode^.ln_Succ <> NIL THEN BEGIN
  699.         IF ANode^.ln_Name <> NIL THEN BEGIN
  700.             StrDispose(ANode^.ln_Name);
  701.             ANode^.ln_Name := StrAlloc(StrLen(data)+1);
  702.             IF ANode^.ln_Name <> NIL THEN BEGIN
  703.                 StrCopy(ANode^.ln_Name,data);
  704.                 result := True;
  705.             END ELSE BEGIN
  706.                 result := FALSE;
  707.             END;
  708.          END;
  709.      END;
  710.      UpDateNode := result;
  711. END;
  712.  
  713. FUNCTION UpDateNode(ANode : pFPCNode; data : String): BOOLEAN;
  714. VAR
  715.    result : BOOLEAN;
  716. BEGIN
  717.     IF ANode^.ln_Succ <> NIL THEN BEGIN
  718.         IF ANode^.ln_Name <> NIL THEN BEGIN
  719.             StrDispose(ANode^.ln_Name);
  720.             ANode^.ln_Name := StrAlloc(Length(data)+1);
  721.             IF ANode^.ln_Name <> NIL THEN BEGIN
  722.                 StrPCopy(ANode^.ln_Name,data);
  723.                 result := True;
  724.             END ELSE BEGIN
  725.                 result := FALSE;
  726.             END;
  727.          END;
  728.      END;
  729.      UpDateNode := result;
  730. END;
  731.  
  732. function FileToList(thefile : PChar; var thelist : pList): boolean;
  733. begin
  734.     FileToList := FileToList(strpas(thefile), thelist);
  735. end;
  736.  
  737. function FileToList(thefile : String; var thelist : pList): boolean;
  738. var
  739.    Inf : Text;
  740.    tempnode : pFPCNode;
  741.    buffer : PChar;
  742.    buf : Array [0..500] of Char;
  743. begin
  744.    buffer := @buf;
  745.    Assign(Inf, thefile);
  746.    {$I-}
  747.    Reset(Inf);
  748.    {$I+}
  749.    if IOResult = 0 then begin
  750.       while not eof(Inf) do begin
  751.       { I don't want end of lines here (for use with amiga listviews)
  752.         just change this if you need newline characters.
  753.       }
  754.          Read(Inf, buffer);
  755.          tempnode := AddNewNode(thelist,buffer);
  756.          Readln(inf, buffer);
  757.       end;
  758.       CLose(Inf);
  759.       FileToList := true;
  760.    end else FileToList := false;
  761. end;
  762.  
  763. function ListToFile(TheFile : PChar; thelist : pList): Boolean;
  764. begin
  765.     ListToFile := ListToFile(strpas(TheFile), thelist);
  766. end;
  767.  
  768. function ListToFile(TheFile : String; thelist : pList): Boolean;
  769. VAR
  770.     Out      : Text;
  771.     i        : Longint;
  772.     dummy    : Longint;
  773.     tempnode : pFPCNode;
  774. begin
  775.     Assign(Out, TheFile);
  776.     {$I-}
  777.     Rewrite(Out);
  778.     {$I+}
  779.     if IOResult = 0 then begin
  780.        i := NodesInList(thelist);
  781.        IF i > 0 THEN BEGIN
  782.           tempnode := pFPCNode(thelist^.lh_Head);
  783.           FOR dummy := 1 TO i DO BEGIN
  784.              IF tempnode^.ln_Name <> NIL THEN BEGIN
  785.                 {
  786.                   Have to check the strlen here, if it's an
  787.                   empty pchar fpc will write out a #0
  788.                 }
  789.                 if strlen(tempnode^.ln_Name) > 0 then
  790.                    WriteLN(Out,tempnode^.ln_Name)
  791.                 else writeln(Out);
  792.              END;
  793.              tempnode := pFPCNode(tempnode^.ln_Succ);
  794.           END;
  795.         END;
  796.         Close(Out);
  797.         ListToFile := True;
  798.     END Else ListToFile := False;
  799. END;
  800.  
  801.  
  802. end.
  803.  
  804.  
  805.  
  806.